home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / vbdStuff.bas < prev    next >
BASIC Source File  |  1999-06-18  |  6KB  |  178 lines
  1. Attribute VB_Name = "vbdStuff"
  2. Option Explicit
  3.  
  4. Private m_OldPen As Long
  5. Private m_OldBrush As Long
  6. Private m_NewBrush As Long
  7. Private m_NewPen As Long
  8.  
  9. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  10. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  11. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  12. Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
  13. Private Type LOGBRUSH
  14.     lbStyle As Long
  15.     lbColor As Long
  16.     lbHatch As Long
  17. End Type
  18.  
  19. Private Const BS_SOLID = 0
  20. Private Const BS_NULL = 1
  21. Private Const BS_HOLLOW = BS_NULL
  22. Private Const BS_HATCHED = 2
  23. Private Const HS_BDIAGONAL = 3
  24. Private Const HS_CROSS = 4
  25. Private Const HS_DIAGCROSS = 5
  26. Private Const HS_FDIAGONAL = 2
  27. Private Const HS_HORIZONTAL = 0
  28. Private Const HS_VERTICAL = 1
  29.  
  30. Public Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
  31. Public Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
  32. Public Type POINTAPI
  33.     X As Long
  34.     Y As Long
  35. End Type
  36.  
  37. ' Bound the objects in the collection.
  38. Public Sub BoundObjects(ByVal the_objects As Collection, ByRef xmin As Single, ByRef ymin As Single, ByRef xmax As Single, ByRef ymax As Single)
  39. Dim x1 As Single
  40. Dim x2 As Single
  41. Dim y1 As Single
  42. Dim y2 As Single
  43. Dim obj As vbdObject
  44.  
  45.     Set obj = the_objects(1)
  46.     obj.Bound xmin, ymin, xmax, ymax
  47.  
  48.     For Each obj In the_objects
  49.         obj.Bound x1, y1, x2, y2
  50.         If xmin > x1 Then xmin = x1
  51.         If xmax < x2 Then xmax = x2
  52.         If ymin > y1 Then ymin = y1
  53.         If ymax < y2 Then ymax = y2
  54.     Next obj
  55. End Sub
  56.  
  57. ' Initialize default drawing properties.
  58. Public Sub InitializeDrawingProperties(ByVal obj As vbdObject)
  59.     obj.DrawWidth = 1
  60.     obj.DrawStyle = vbSolid
  61.     obj.ForeColor = vbBlack
  62.     obj.FillColor = vbBlack
  63.     obj.FillStyle = vbFSTransparent
  64. End Sub
  65. ' Return the drawing property serialization
  66. ' for this object.
  67. Public Function DrawingPropertySerialization(ByVal obj As vbdObject) As String
  68. Dim txt As String
  69.  
  70.     txt = txt & " DrawWidth(" & Format$(obj.DrawWidth) & ")"
  71.     txt = txt & " DrawStyle(" & Format$(obj.DrawStyle) & ")"
  72.     txt = txt & " ForeColor(" & Format$(obj.ForeColor) & ")"
  73.     txt = txt & " FillColor(" & Format$(obj.FillColor) & ")"
  74.     txt = txt & " FillStyle(" & Format$(obj.FillStyle) & ")"
  75.  
  76.     DrawingPropertySerialization = txt & vbCrLf & "    "
  77. End Function
  78.  
  79. ' Read the token name and value and to see
  80. ' if it is drawing property information.
  81. Public Sub ReadDrawingPropertySerialization(ByVal obj As vbdObject, ByVal token_name As String, ByVal token_value As String)
  82.     Select Case token_name
  83.         Case "DrawWidth"
  84.             obj.DrawWidth = CInt(token_value)
  85.         Case "DrawStyle"
  86.             obj.DrawStyle = CInt(token_value)
  87.         Case "ForeColor"
  88.             obj.ForeColor = CLng(token_value)
  89.         Case "FillColor"
  90.             obj.FillColor = CLng(token_value)
  91.         Case "FillStyle"
  92.             obj.FillStyle = CInt(token_value)
  93.     End Select
  94. End Sub
  95.  
  96.  
  97. ' Set the drawing properties for the canvas.
  98. Public Sub SetCanvasDrawingParameters(ByVal obj As vbdObject, ByVal Canvas As Object)
  99.     Canvas.DrawWidth = obj.DrawWidth
  100.     Canvas.DrawStyle = obj.DrawStyle
  101.     Canvas.ForeColor = obj.ForeColor
  102.     Canvas.FillColor = obj.FillColor
  103.     Canvas.FillStyle = obj.FillStyle
  104. End Sub
  105. ' Set the drawing properties for the metafile.
  106. Public Sub SetMetafileDrawingParameters(ByVal obj As vbdObject, ByVal mf_dc As Long)
  107. Dim log_brush As LOGBRUSH
  108. Dim new_brush As Long
  109. Dim new_pen As Long
  110.  
  111.     With log_brush
  112.         If obj.FillStyle = vbFSTransparent Then
  113.             .lbStyle = BS_HOLLOW
  114.         ElseIf obj.FillStyle = vbFSSolid Then
  115.             .lbStyle = BS_SOLID
  116.         Else
  117.             .lbStyle = BS_HATCHED
  118.             Select Case obj.FillStyle
  119.                 Case vbCross
  120.                     .lbHatch = HS_CROSS
  121.                 Case vbDiagonalCross
  122.                     .lbHatch = HS_DIAGCROSS
  123.                 Case vbDownwardDiagonal
  124.                     .lbHatch = HS_BDIAGONAL
  125.                 Case vbHorizontalLine
  126.                     .lbHatch = HS_HORIZONTAL
  127.                 Case vbUpwardDiagonal
  128.                     .lbHatch = HS_FDIAGONAL
  129.                 Case vbVerticalLine
  130.                     .lbHatch = HS_VERTICAL
  131.             End Select
  132.         End If
  133.         .lbColor = obj.FillColor
  134.     End With
  135.  
  136.     m_NewPen = CreatePen(obj.DrawStyle, obj.DrawWidth, obj.ForeColor)
  137.     m_NewBrush = CreateBrushIndirect(log_brush)
  138.     m_OldPen = SelectObject(mf_dc, m_NewPen)
  139.     m_OldBrush = SelectObject(mf_dc, m_NewBrush)
  140. End Sub
  141. ' Restore the drawing properties for the metafile.
  142. Public Sub RestoreMetafileDrawingParameters(ByVal mf_dc As Long)
  143.     SelectObject mf_dc, m_OldBrush
  144.     SelectObject mf_dc, m_OldPen
  145.     DeleteObject m_NewBrush
  146.     DeleteObject m_NewPen
  147. End Sub
  148. ' Return the serialization for this
  149. ' transformation matrix.
  150. Public Function TransformationSerialization(M() As Single) As String
  151. Dim i As Integer
  152. Dim j As Integer
  153. Dim txt As String
  154.  
  155.     For i = 1 To 3
  156.         For j = 1 To 3
  157.             txt = txt & Format$(M(i, j)) & " "
  158.         Next j
  159.     Next i
  160.  
  161.     TransformationSerialization = _
  162.         "Transformation(" & txt & ")"
  163. End Function
  164. ' initialize the transformation matrix
  165. ' using this serialization.
  166. Public Sub SetTransformationSerialization(ByVal txt As String, M() As Single)
  167. Dim i As Integer
  168. Dim j As Integer
  169. Dim token As String
  170.  
  171.     For i = 1 To 3
  172.         For j = 1 To 3
  173.             token = GetDelimitedToken(txt, " ")
  174.             M(i, j) = CSng(token)
  175.         Next j
  176.     Next i
  177. End Sub
  178.